home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / PASCAL / ALLSWAGS.ZIP / SWAGG-M.ZIP / MISC.SWG / 0165_Wolf3D mapedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-25  |  30.5 KB  |  1,168 lines
  1. {Well, here it is, this is 1 of 2}
  2.  
  3. {
  4.   MapEdit 4.1     Wolfenstein Map Editor
  5.  
  6.      Copyright (c) 1992  Bill Kirby
  7. }
  8.  
  9. {$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,V-,X-}
  10. {$M 16384,0,655360}
  11. program mapedit;
  12.  
  13. uses crt,dos,graph,mouse; { mouse unit in MOUSE.SWG }
  14.  
  15. const MAP_X = 6;
  16.       MAP_Y = 6;
  17.       TEXTLOC = 460;
  18.  
  19.       GAMEPATH     : string = '.\';
  20.       HEADFILENAME : string = 'maphead';
  21.       MAPFILENAME  : string = 'maptemp';
  22.       LEVELS       : word   = 10;
  23.       GAME_VERSION : real   = 1.0;
  24.  
  25. type data_block = record
  26.        size : word;
  27.        data : pointer;
  28.      end;
  29.  
  30.      level_type = record
  31.        map,
  32.        objects,
  33.        other           : data_block;
  34.        width,
  35.        height          : word;
  36.        name            : string[16];
  37.      end;
  38.  
  39.      grid = array[0..63,0..63] of word;
  40.  
  41.      filltype = (solid,check);
  42.      doortype = (horiz,vert);
  43.  
  44.  
  45. var levelmap,
  46.     objectmap    : grid;
  47.     maps         : array[1..60] of level_type;
  48.  
  49.     show_objects,
  50.     show_floor   : boolean;
  51.  
  52.     mapgraph,
  53.     objgraph     : array[0..511] of string[4];
  54.     mapnames,
  55.     objnames     : array[0..511] of string[20];
  56.  
  57.     themouse  : resetrec;
  58.     mouseloc  : locrec;
  59.  
  60. procedure waitforkey;
  61. var key: char;
  62. begin
  63.   repeat until keypressed;
  64.   key:= readkey;
  65.   if key=#0 then key:= readkey;
  66. end;
  67.  
  68. procedure getkey(var key: char; var control: boolean);
  69. begin
  70.   control:= false;
  71.   key:= readkey;
  72.   if key=#0 then
  73.     begin
  74.       control:= true;
  75.       key:= readkey;
  76.     end;
  77. end;
  78.  
  79. procedure decorate(x,y,c: integer);
  80. var i,j: integer;
  81. begin
  82.   setfillstyle(1,c);
  83.   bar(x*7+MAP_X+2,y*7+MAP_Y+2,x*7+MAP_X+4,y*7+MAP_Y+4);
  84. end;
  85.  
  86. procedure box(fill: filltype; x,y,c1,c2: integer; dec: boolean);
  87. begin
  88.   if fill=solid then
  89.     setfillstyle(1,c1)
  90.   else
  91.     setfillstyle(9,c1);
  92.  
  93.   bar(x*7+MAP_X,y*7+MAP_Y,x*7+6+MAP_X,y*7+6+MAP_Y);
  94.   if dec then decorate(x,y,c2);
  95. end;
  96.  
  97. procedure outtext(x,y,color: integer; s: string);
  98. begin
  99.   setcolor(color);
  100.   outtextxy(x*7+MAP_X,y*7+MAP_Y,s);
  101. end;
  102.  
  103. function hex(x: word): string;
  104. const digit : string[16] = '0123456789ABCDEF';
  105. var temp : string[4];
  106.     i    : integer;
  107. begin
  108.   temp:= '    ';
  109.   for i:= 4 downto 1 do
  110.     begin
  111.       temp[i]:= digit[(x and $000f)+1];
  112.       x:= x div 16;
  113.     end;
  114.   hex:= temp;
  115. end;
  116.  
  117. function hexbyte(x: byte): string;
  118. const digit : string[16] = '0123456789ABCDEF';
  119. var temp : string[4];
  120.     i    : integer;
  121. begin
  122.   temp:= '  ';
  123.   for i:= 2 downto 1 do
  124.     begin
  125.       temp[i]:= digit[(x and $000f)+1];
  126.       x:= x div 16;
  127.     end;
  128.   hexbyte:= temp;
  129. end;
  130.  
  131. procedure doline(x,y,x2,y2: integer);
  132. begin
  133.   line(x+MAP_X,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  134. end;
  135.  
  136. procedure dobar(x,y,x2,y2: integer);
  137. begin
  138.   bar(x+MAP_Y,y+MAP_Y,x2+MAP_X,y2+MAP_Y);
  139. end;
  140.  
  141. procedure circle(x,y,c1,c2: integer);
  142. const sprite : array[0..6,0..6] of byte =
  143.                    ((0,0,1,1,1,0,0),
  144.                     (0,1,1,1,1,1,0),
  145.                     (1,1,1,2,1,1,1),
  146.                     (1,1,2,2,2,1,1),
  147.                     (1,1,1,2,1,1,1),
  148.                     (0,1,1,1,1,1,0),
  149.                     (0,0,1,1,1,0,0));
  150. var i,j,c: integer;
  151. begin
  152.   for i:= 0 to 6 do
  153.     for j:= 0 to 6 do
  154.       begin
  155.         case sprite[i,j] of
  156.           0: c:=0;
  157.           1: c:=c1;
  158.           2: c:=c2;
  159.         end;
  160.         putpixel(x*7+MAP_X+i,y*7+MAP_Y+j,c);
  161.       end;
  162. end;
  163.  
  164. procedure door(dtype: doortype; x,y,color: integer);
  165. begin
  166.   case dtype of
  167.     vert: begin
  168.             setfillstyle(1,color);
  169.             dobar(x*7+2,y*7,x*7+4,y*7+6);
  170.           end;
  171.     horiz : begin
  172.               setfillstyle(1,color);
  173.               dobar(x*7,y*7+2,x*7+6,y*7+4);
  174.           end;
  175.   end;
  176. end;
  177.  
  178. function hexnibble(c: char): byte;
  179. begin
  180.   case c of
  181.     '0'..'9': hexnibble:= ord(c)-ord('0');
  182.     'a'..'f': hexnibble:= ord(c)-ord('a')+10;
  183.     'A'..'F': hexnibble:= ord(c)-ord('A')+10;
  184.     else hexnibble:= 0;
  185.   end;
  186. end;
  187.  
  188. procedure output(x,y: integer; data: string);
  189. var size  : integer;
  190.     temp  : string[4];
  191.     c1,c2 : byte;
  192. begin
  193.   if data<>'0000' then
  194.     begin
  195.       temp:= data;
  196.       c1:= hexnibble(temp[1]);
  197.       c2:= hexnibble(temp[2]);
  198.       case temp[3] of
  199.         '0': outtext(x,y,c1,temp[4]);
  200.         '1': box(solid,x,y,c1,c2,false);
  201.         '2': box(check,x,y,c1,c2,false);
  202.         '3': box(solid,x,y,c1,c2,true);
  203.         '4': box(check,x,y,c1,c2,true);
  204.         '5': circle(x,y,c1,c2);
  205.         '6': door(horiz,x,y,c1);
  206.         '7': door(vert,x,y,c1);
  207.         '8': begin
  208.                setfillstyle(1,c1);
  209.                dobar(x*7,y*7,x*7+6,y*7+3);
  210.                setfillstyle(1,c2);
  211.                dobar(x*7,y*7+4,x*7+6,y*7+6);
  212.               end;
  213.         '9': putpixel(x*7+MAP_X+3,y*7+MAP_Y+3,c1);
  214.         'a': begin setfillstyle(1,c1); dobar(x*7+2,y*7+1,x*7+4,y*7+5); end;
  215.         'b': begin setfillstyle(1,c1); dobar(x*7+2,y*7+2,x*7+4,y*7+4); end;
  216.         'c': begin setfillstyle(1,c1); dobar(x*7+1,y*7+1,x*7+5,y*7+5); end;
  217.         'd': begin
  218.                setcolor(c1);
  219.                doline(x*7+1,y*7+1,x*7+5,y*7+5);
  220.                doline(x*7+5,y*7+1,x*7+1,y*7+5);
  221.              end;
  222.         'e': begin
  223.                setcolor(c1);
  224.                rectangle(x*7+MAP_X,y*7+MAP_Y,x*7+MAP_X+6,y*7+MAP_Y+6);
  225.              end;
  226.         'f': case c2 of
  227.               2: begin {east}
  228.                    setcolor(c1);
  229.                    doline(x*7,y*7+3,x*7+6,y*7+3);
  230.                    doline(x*7+6,y*7+3,x*7+3,y*7);
  231.                    doline(x*7+6,y*7+3,x*7+3,y*7+6);
  232.                 end;
  233.               0: begin {north}
  234.                    setcolor(c1);
  235.                    doline(x*7+3,y*7+6,x*7+3,y*7);
  236.                    doline(x*7+3,y*7,x*7,y*7+3);
  237.                    doline(x*7+3,y*7,x*7+6,y*7+3);
  238.                  end;
  239.               6: begin {west}
  240.                    setcolor(c1);
  241.                    doline(x*7+6,y*7+3,x*7,y*7+3);
  242.                    doline(x*7,y*7+3,x*7+3,y*7);
  243.                    doline(x*7,y*7+3,x*7+3,y*7+6);
  244.                  end;
  245.               4: begin {south}
  246.                    setcolor(c1);
  247.                    doline(x*7+3,y*7,x*7+3,y*7+6);
  248.                    doline(x*7+3,y*7+6,x*7,y*7+3);
  249.                    doline(x*7+3,y*7+6,x*7+6,y*7+3);
  250.                  end;
  251.               1: begin {northeast}
  252.                    setcolor(c1);
  253.                    doline(x*7,y*7+6,x*7+6,y*7);
  254.                    doline(x*7+6,y*7,x*7+3,y*7);
  255.                    doline(x*7+6,y*7,x*7+6,y*7+3);
  256.                  end;
  257.               7: begin {northwest}
  258.                    setcolor(c1);
  259.                    doline(x*7+6,y*7+6,x*7,y*7);
  260.                    doline(x*7,y*7,x*7+3,y*7);
  261.                    doline(x*7,y*7,x*7,y*7+3);
  262.                  end;
  263.               3: begin {southeast}
  264.                    setcolor(c1);
  265.                    doline(x*7,y*7,x*7+6,y*7+6);
  266.                    doline(x*7+6,y*7+6,x*7+3,y*7+6);
  267.                    doline(x*7+6,y*7+6,x*7+6,y*7+3);
  268.                  end;
  269.               5: begin {southwest}
  270.                    setcolor(c1);
  271.                    doline(x*7+6,y*7,x*7,y*7+6);
  272.                    doline(x*7,y*7+6,x*7+3,y*7+6);
  273.                    doline(x*7,y*7+6,x*7,y*7+3);
  274.                  end;
  275.  
  276.              end;
  277.       end;
  278.     end;
  279. end;
  280.  
  281. procedure display_map;
  282. var i,j: integer;
  283. begin
  284.   j:= 63;
  285.   i:= 0;
  286.   repeat
  287.     setfillstyle(1,0);
  288.     dobar(i*7,j*7,i*7+6,j*7+6);
  289.     if show_floor then
  290.       output(i,j,mapgraph[levelmap[i,j]])
  291.     else
  292.       if not (levelmap[i,j] in [$6a..$8f]) then
  293.         output(i,j,mapgraph[levelmap[i,j]]);
  294.     if show_objects then
  295.       output(i,j,objgraph[objectmap[i,j]]);
  296.     inc(i);
  297.     if i=64 then
  298.       begin
  299.         i:= 0;
  300.         dec(j);
  301.       end;
  302.   until (j<0) or keypressed;
  303. end;
  304.  
  305. procedure read_levels;
  306. var headfile,
  307.     mapfile  : file;
  308.     s,o,
  309.     size     : word;
  310.     idsig    : string[4];
  311.     level    : integer;
  312.     levelptr : longint;
  313.     tempstr  : string[16];
  314.     map_pointer,
  315.     object_pointer,
  316.     other_pointer    : longint;
  317.  
  318. begin
  319.   idsig:= '    ';
  320.   tempstr:= '                ';
  321.   assign(headfile,GAMEPATH+HEADFILENAME);
  322.   {$I-}
  323.   reset(headfile,1);
  324.   {$I+}
  325.   if ioresult<>0 then
  326.     begin
  327.       writeln('error opening ',HEADFILENAME);
  328.       halt(1);
  329.     end;
  330.   assign(mapfile,GAMEPATH+MAPFILENAME);
  331.   {$I-}
  332.   reset(mapfile,1);
  333.   {$I+}
  334.   if ioresult<>0 then
  335.     begin
  336.       writeln('error opening ',MAPFILENAME);
  337.       halt(1);
  338.     end;
  339.  
  340.   for level:= 1 to LEVELS do
  341.     begin
  342.       seek(headfile,2+(level-1)*4);
  343.       blockread(headfile,levelptr,4);
  344.       seek(mapfile,levelptr);
  345.       with maps[level] do
  346.         begin
  347.           blockread(mapfile,map_pointer,4);
  348.           blockread(mapfile,object_pointer,4);
  349.           blockread(mapfile,other_pointer,4);
  350.           blockread(mapfile,map.size,2);
  351.           blockread(mapfile,objects.size,2);
  352.           blockread(mapfile,other.size,2);
  353.           blockread(mapfile,width,2);
  354.           blockread(mapfile,height,2);
  355.           name[0]:=#16;
  356.           blockread(mapfile,name[1],16);
  357.           if GAME_VERSION = 1.1 then
  358.             blockread(mapfile,idsig[1],4);
  359.  
  360.           seek(mapfile,map_pointer);
  361.           getmem(map.data,map.size);
  362.           s:= seg(map.data^);
  363.           o:= ofs(map.data^);
  364.           blockread(mapfile,mem[s:o],map.size);
  365.  
  366.           seek(mapfile,object_pointer);
  367.           getmem(objects.data,objects.size);
  368.           s:= seg(objects.data^);
  369.           o:= ofs(objects.data^);
  370.           blockread(mapfile,mem[s:o],objects.size);
  371.  
  372.           seek(mapfile,other_pointer);
  373.           getmem(other.data,other.size);
  374.           s:= seg(other.data^);
  375.           o:= ofs(other.data^);
  376.           blockread(mapfile,mem[s:o],other.size);
  377.           if GAME_VERSION = 1.0 then
  378.             blockread(mapfile,idsig[1],4);
  379.         end;
  380.     end;
  381.   close(mapfile);
  382.   close(headfile);
  383. end;
  384.  
  385. procedure write_levels;
  386. var headfile,
  387.     mapfile    : file;
  388.     abcd,
  389.     s,o,
  390.     size     : word;
  391.     idsig    : string[4];
  392.     level    : integer;
  393.     levelptr : longint;
  394.     tempstr  : string[16];
  395.     map_pointer,
  396.     object_pointer,
  397.     other_pointer    : longint;
  398.  
  399. begin
  400.   abcd:= $abcd;
  401.   idsig:= '!ID!';
  402.   tempstr:= 'TED5v1.0';
  403.   assign(headfile,GAMEPATH+HEADFILENAME);
  404.   rewrite(headfile,1);
  405.   assign(mapfile,GAMEPATH+MAPFILENAME);
  406.   rewrite(mapfile,1);
  407.  
  408.   blockwrite(headfile,abcd,2);
  409.   blockwrite(mapfile,tempstr[1],8);
  410.   levelptr:= 8;
  411.  
  412.   for level:= 1 to LEVELS do
  413.     begin
  414.       with maps[level] do
  415.         begin
  416.           if GAME_VERSION = 1.1 then
  417.             begin
  418.               map_pointer:= levelptr;
  419.               s:= seg(map.data^);
  420.               o:= ofs(map.data^);
  421.               blockwrite(mapfile,mem[s:o],map.size);
  422.               inc(levelptr,map.size);
  423.  
  424.               object_pointer:= levelptr;
  425.               s:= seg(objects.data^);
  426.               o:= ofs(objects.data^);
  427.               blockwrite(mapfile,mem[s:o],objects.size);
  428.               inc(levelptr,objects.size);
  429.  
  430.               other_pointer:= levelptr;
  431.               s:= seg(other.data^);
  432.               o:= ofs(other.data^);
  433.               blockwrite(mapfile,mem[s:o],other.size);
  434.               inc(levelptr,other.size);
  435.  
  436.               blockwrite(headfile,levelptr,4);
  437.  
  438.               blockwrite(mapfile,map_pointer,4);
  439.               blockwrite(mapfile,object_pointer,4);
  440.               blockwrite(mapfile,other_pointer,4);
  441.               blockwrite(mapfile,map.size,2);
  442.               blockwrite(mapfile,objects.size,2);
  443.               blockwrite(mapfile,other.size,2);
  444.               blockwrite(mapfile,width,2);
  445.               blockwrite(mapfile,height,2);
  446.               name[0]:=#16;
  447.               blockwrite(mapfile,name[1],16);
  448.               inc(levelptr,38);
  449.             end
  450.           else
  451.             begin
  452.               blockwrite(headfile,levelptr,4);
  453.               map_pointer:= levelptr+38;
  454.               object_pointer:= map_pointer+map.size;
  455.               other_pointer:= object_pointer+objects.size;
  456.  
  457.               blockwrite(mapfile,map_pointer,4);
  458.               blockwrite(mapfile,object_pointer,4);
  459.               blockwrite(mapfile,other_pointer,4);
  460.               blockwrite(mapfile,map.size,2);
  461.               blockwrite(mapfile,objects.size,2);
  462.               blockwrite(mapfile,other.size,2);
  463.               blockwrite(mapfile,width,2);
  464.               blockwrite(mapfile,height,2);
  465.               name[0]:=#16;
  466.               blockwrite(mapfile,name[1],16);
  467.  
  468.               s:= seg(map.data^);
  469.               o:= ofs(map.data^);
  470.               blockwrite(mapfile,mem[s:o],map.size);
  471.               s:= seg(objects.data^);
  472.               o:= ofs(objects.data^);
  473.               blockwrite(mapfile,mem[s:o],objects.size);
  474.               s:= seg(other.data^);
  475.               o:= ofs(other.data^);
  476.               blockwrite(mapfile,mem[s:o],other.size);
  477.               inc(levelptr,map.size+objects.size+other.size+38);
  478.             end;
  479.           blockwrite(mapfile,idsig[1],4);
  480.           inc(levelptr,4);
  481.         end;
  482.     end;
  483.   close(mapfile);
  484.   close(headfile);
  485. end;
  486.  
  487. procedure a7a8_expand(src: data_block; var dest: data_block);
  488. var s,o,
  489.     s2,o2,
  490.     index,
  491.     index2,
  492.     size,
  493.     length,
  494.     data,
  495.     newsize  : word;
  496.     goback1  : byte;
  497.     goback2  : word;
  498.     i        : integer;
  499.  
  500. begin
  501.   s:=seg(src.data^);
  502.   o:=ofs(src.data^);
  503.   index:=0;
  504.   move(mem[s:o+index],dest.size,2); inc(index,2);
  505.   getmem(dest.data,dest.size);
  506.   s2:=seg(dest.data^);
  507.   o2:=ofs(dest.data^);
  508.   index2:=0;
  509.  
  510.   repeat
  511.     move(mem[s:o+index],data,2); inc(index,2);
  512.     case hi(data) of
  513.       $a7: begin
  514.              length:=lo(data);
  515.              move(mem[s:o+index],goback1,1); inc(index,1);
  516.              move(mem[s2:o2+index2-goback1*2],mem[s2:o2+index2],length*2);
  517.              inc(index2,length*2);
  518.            end;
  519.       $a8: begin
  520.              length:=lo(data);
  521.              move(mem[s:o+index],goback2,2); inc(index,2);
  522.              move(mem[s2:o2+goback2*2],mem[s2:o2+index2],length*2);
  523.              inc(index2,length*2);
  524.            end;
  525.       else begin
  526.              move(data,mem[s2:o2+index2],2);
  527.              inc(index2,2);
  528.            end;
  529.     end;
  530.   until index=src.size;
  531. end;
  532.  
  533. procedure expand(d: data_block; var g: grid);
  534. var i,x,y : integer;
  535.     s,o,
  536.     data,
  537.     count : word;
  538.     temp  : data_block;
  539. begin
  540.   if GAME_VERSION = 1.1 then
  541.     a7a8_expand(d,temp)
  542.   else
  543.     temp:=d;
  544.  
  545.   x:= 0;
  546.   y:= 0;
  547.   s:= seg(temp.data^);
  548.   o:= ofs(temp.data^);
  549.   inc(o,2);
  550.   while (y<64) do
  551.     begin
  552.       move(mem[s:o],data,2); inc(o,2);
  553.       if data=$abcd then
  554.         begin
  555.           move(mem[s:o],count,2); inc(o,2);
  556.           move(mem[s:o],data,2); inc(o,2);
  557.           for i:= 1 to count do
  558.             begin
  559.               g[x,y]:= data;
  560.               inc(x);
  561.               if x=64 then
  562.                 begin
  563.                   x:= 0;
  564.                   inc(y);
  565.                 end;
  566.             end;
  567.         end
  568.       else
  569.         begin
  570.           g[x,y]:= data;
  571.           inc(x);
  572.           if x=64 then
  573.             begin
  574.               x:= 0;
  575.               inc(y);
  576.             end;
  577.         end;
  578.     end;
  579.   if GAME_VERSION=1.1 then
  580.     freemem(temp.data,temp.size);
  581. end;
  582.  
  583. procedure compress(g: grid; var d: data_block);
  584. var temp     : pointer;
  585.     size: word;
  586.     abcd,
  587.     s,o,
  588.     olddata,
  589.     data,
  590.     nextdata,
  591.     count    : word;
  592.     x,y,i    : integer;
  593.     temp2    : pointer;
  594.  
  595. begin
  596.   abcd:= $abcd;
  597.   x:= 0;
  598.   y:= 0;
  599.   getmem(temp,8194);
  600.   s:= seg(temp^);
  601.   o:= ofs(temp^);
  602.   data:= $2000;
  603.   move(data,mem[s:o],2);
  604.  
  605.   size:= 2;
  606.   data:= g[0,0];
  607.   while (y<64) do
  608.     begin
  609.       count:= 1;
  610.       repeat
  611.         inc(x);
  612.         if x=64 then
  613.           begin
  614.             x:=0;
  615.             inc(y);
  616.           end;
  617.         if y<64 then
  618.           nextdata:= g[x,y];
  619.         inc(count);
  620.       until (nextdata<>data) or (y=64);
  621.       dec(count);
  622.       if count<3 then
  623.         begin
  624.           for i:= 1 to count do
  625.             begin
  626.               move(data,mem[s:o+size],2);
  627.               inc(size,2);
  628.             end;
  629.         end
  630.       else
  631.         begin
  632.           move(abcd,mem[s:o+size],2);
  633.           inc(size,2);
  634.           move(count,mem[s:o+size],2);
  635.           inc(size,2);
  636.           move(data,mem[s:o+size],2);
  637.           inc(size,2);
  638.         end;
  639.       data:= nextdata;
  640.     end;
  641.   getmem(temp2,size);
  642.   move(temp^,temp2^,size);
  643.   freemem(temp,8194);
  644.   if GAME_VERSION = 1.1 then
  645.     begin
  646.       getmem(temp,size+2);
  647.       s:= seg(temp^);
  648.       o:= ofs(temp^);
  649.       move(size,mem[s:o],2);
  650.       move(temp2^,mem[s:o+2],size);
  651.       d.data:=temp;
  652.       d.size:= size+2;
  653.       freemem(temp2,size);
  654.     end
  655.   else
  656.     begin
  657.       d.data:= temp2;
  658.       d.size:= size;
  659.     end;
  660. end;
  661.  
  662. procedure clear_level(n: integer);
  663. var x,y: integer;
  664. begin
  665.    mhide;
  666.    for x:= 0 to 63 do
  667.      for y:= 0 to 63 do
  668.        begin
  669.          levelmap[x,y]:= $8c;
  670.          objectmap[x,y]:= 0;
  671.        end;
  672.    for x:= 0 to 63 do
  673.      begin
  674.        levelmap[x,0]:= 1;
  675.        levelmap[x,63]:= 1;
  676.        levelmap[0,x]:= 1;
  677.        levelmap[63,x]:= 1;
  678.      end;
  679.    display_map;
  680.    mshow;
  681. end;
  682.  
  683. function str_to_hex(s: string): word;
  684. var temp : word;
  685.     i    : integer;
  686. begin
  687.   temp:= 0;
  688.   for i:= 1 to length(s) do
  689.     begin
  690.       temp:= temp * 16;
  691.       case s[i] of
  692.         '0'..'9': temp:= temp + ord(s[i])-ord('0');
  693.         'a'..'f': temp:= temp + ord(s[i])-ord('a')+10;
  694.         'A'..'F': temp:= temp + ord(s[i])-ord('A')+10;
  695.       end;
  696.     end;
  697.   str_to_hex:= temp;
  698. end;
  699.  
  700. procedure showlegend(which,start,n: integer);
  701. var i,x,y: integer;
  702.     save: boolean;
  703. begin
  704.   mhide;
  705.   save:= show_objects;
  706.   show_objects:= true;
  707.   setfillstyle(1,0);
  708.   bar(64*7+MAP_X+13,4,639-5,380-30);
  709.   x:= 66;
  710.   y:= 0;
  711.   for i:= start to start+n-1 do
  712.     begin
  713.       if which=0 then
  714.         begin
  715.           output(x,y,mapgraph[i]);
  716.           outtext(x+2,y,15,mapnames[i]);
  717.         end
  718.       else
  719.         begin
  720.           output(x,y,objgraph[i]);
  721.           outtext(x+2,y,15,objnames[i]);
  722.         end;
  723.       inc(y,2);
  724.     end;
  725.   show_objects:= save;
  726.   mshow;
  727. end;
  728.  
  729. function inside(x1,y1,x2,y2,x,y: integer): boolean;
  730. begin
  731.   inside:= (x>=x1) and (x<=x2) and
  732.            (y>=y1) and (y<=y2);
  733. end;
  734.  
  735. procedure wait_for_mouserelease;
  736. begin
  737.   repeat
  738.     mpos(mouseloc);
  739.   until mouseloc.buttonstatus=0;
  740. end;
  741.  
  742. procedure bevel(x1,y1,x2,y2,c1,c2,c3: integer);
  743. begin
  744.   setfillstyle(1,c1);
  745.   bar(x1,y1,x2,y2);
  746.   setcolor(c2);
  747.   line(x1,y1,x2,y1);
  748.   line(x1+1,y1+1,x2-1,y1+1);
  749.   line(x2,y1,x2,y2);
  750.   line(x2-1,y1,x2-1,y2-1);
  751.   setcolor(c3);
  752.   line(x1,y1+1,x1,y2);
  753.   line(x1+1,y1+2,x1+1,y2);
  754.   line(x1,y2,x2-1,y2);
  755.   line(x1+1,y2-1,x2-2,y2-1);
  756. end;
  757.  
  758. function upper(s: string): string;
  759. var i: integer;
  760. begin
  761.   for i:=1 to length(s) do
  762.     if s[i] in ['a'..'z'] then
  763.       s[i]:=chr(ord(s[i])-ord('a')+ord('A'));
  764.   upper:=s;
  765. end;
  766.  
  767. procedure initialize;
  768. var i: integer;
  769.     infile: text;
  770.  
  771.     path : pathstr;
  772.     dir  : dirstr;
  773.     name : namestr;
  774.     ext  : extstr;
  775.     filename  : string;
  776.     hexstr    : string[4];
  777.     graphstr  : string[4];
  778.     name20    : string[20];
  779.     junk      : char;
  780.     search    : searchrec;
  781.  
  782. begin
  783.   filename:= GAMEPATH + HEADFILENAME + '.*';
  784.   writeln('searching for ',filename);
  785.   findfirst(filename,$ff,search);
  786.   if doserror<>0 then
  787.     begin
  788.       writeln('Error opening ',HEADFILENAME,' file.');
  789.       writeln;
  790.       writeln('Be sure that you installed MAPEDIT in the directory where');
  791.       writeln('Wolfenstein 3-D is installed.');
  792.       halt(0);
  793.     end
  794.   else
  795.     begin
  796.       filename:= search.name;
  797.       fsplit(filename,dir,name,ext);
  798.       HEADFILENAME:= upper(HEADFILENAME+ext);
  799.       if upper(ext)='.WL1' then
  800.         begin
  801.           LEVELS:=10;
  802.           GAME_VERSION:=1.0;
  803.           MAPFILENAME:='MAPTEMP'+ext;
  804.           filename:=GAMEPATH+'MAPTEMP'+ext;
  805.           findfirst(filename,$ff,search);
  806.           if doserror<>0 then
  807.             begin
  808.               GAME_VERSION:=1.1;
  809.               MAPFILENAME:='GAMEMAPS'+ext;
  810.               filename:=GAMEPATH+'GAMEMAPS'+ext;
  811.               findfirst(filename,$ff,search);
  812.               if doserror<>0 then
  813.                 begin
  814.                   writeln('Error opening GAMEMAPS or MAPTEMP file.');
  815.                   halt(0);
  816.                 end;
  817.             end;
  818.         end;
  819.       if (upper(ext)='.WL3') or (upper(ext)='.WL6') then
  820.         begin
  821.           GAME_VERSION:=1.1;
  822.           if upper(ext)='.WL3' then
  823.             LEVELS:= 30
  824.           else
  825.             LEVELS:= 60;
  826.           MAPFILENAME:='GAMEMAPS'+ext;
  827.           filename:=GAMEPATH+'GAMEMAPS'+ext;
  828.           findfirst(filename,$ff,search);
  829.           if doserror<>0 then
  830.             begin
  831.               writeln('Error opening GAMEMAPS file.');
  832.               halt(0);
  833.             end;
  834.         end;
  835.     end;
  836.  
  837.   for i:= 0 to 511 do
  838.     begin
  839.       mapnames[i]:= 'unknown '+hex(i);
  840.       objnames[i]:= 'unknown '+hex(i);
  841.       mapgraph[i]:= 'f010';
  842.       objgraph[i]:= 'f010';
  843.     end;
  844.   assign(infile,'mapdata.def');
  845.   reset(infile);
  846.   while not eof(infile) do
  847.     begin
  848.       readln(infile,hexstr,junk,graphstr,junk,name20);
  849.       mapnames[str_to_hex(hexstr)]:= name20;
  850.       mapgraph[str_to_hex(hexstr)]:= graphstr;
  851.     end;
  852.   close(infile);
  853.  
  854.   assign(infile,'objdata.def');
  855.   reset(infile);
  856.   while not eof(infile) do
  857.     begin
  858.       readln(infile,hexstr,junk,graphstr,junk,name20);
  859.       objnames[str_to_hex(hexstr)]:= name20;
  860.       objgraph[str_to_hex(hexstr)]:= graphstr;
  861.     end;
  862.   close(infile);
  863.  
  864. end;
  865.  
  866. var gd,gm,
  867.     i,j,x,y   : integer;
  868.     infile    : text;
  869.     level     : word;
  870.     oldx,oldy : integer;
  871.     done      : boolean;
  872.     outstr,
  873.     tempstr   : string;
  874.  
  875.     legendpos : integer;
  876.     legendtype: integer;
  877.     newj        : integer;
  878.     currenttype,
  879.     currentval: integer;
  880.  
  881.     oldj,oldi : integer;
  882.  
  883.     key       : char;
  884.     control   : boolean;
  885.  
  886. begin
  887.   clrscr;
  888.   initialize;
  889.   directvideo:=false;
  890.   read_levels;
  891.  
  892.   gd:= vga;
  893.   gm:= vgahi;
  894.   initgraph(gd,gm,'');
  895.  
  896.   settextstyle(0,0,1);
  897.   mreset(themouse);
  898.  
  899.   show_objects:= true;
  900.   show_floor:= false;
  901.  
  902.   x:= port[$3da];
  903.   port[$3c0]:= 0;
  904.  
  905.   setfillstyle(1,7);
  906.   bar(0,0,64*7+MAP_X+4,64*7+MAP_Y+4);
  907.   bar(64*7+MAP_X+9,0,639,380);
  908.   setfillstyle(1,0);
  909.   bar(2,2,64*7+MAP_X+2,64*7+MAP_Y+2);
  910.   bar(64*7+MAP_X+11,2,637,380-28);
  911.   bar(64*7+MAP_X+11,380-25,637,378);
  912.   setcolor(15);
  913.   outtextxy(64*7+MAP_X+15,380-16,' MAP  OBJ  UP  DOWN');
  914.   setfillstyle(1,7);
  915.   bar(64*7+MAP_X+11+043,380-25,64*7+MAP_X+11+044,378);
  916.   bar(64*7+MAP_X+11+083,380-25,64*7+MAP_X+11+084,378);
  917.   bar(64*7+MAP_X+11+113,380-25,64*7+MAP_X+11+114,378);
  918.  
  919.   legendpos:= 0;
  920.   legendtype:= 0;
  921.   currenttype:= 0;
  922.   currentval:= 1;
  923.   setfillstyle(1,0);
  924.  
  925.   bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  926.   if currenttype=0 then
  927.     begin
  928.       output(66,60,mapgraph[currentval]);
  929.       outtext(67,60,15,' - '+mapnames[currentval]);
  930.     end
  931.   else
  932.     begin
  933.       output(66,60,objgraph[currentval]);
  934.       outtext(67,60,15,' - '+objnames[currentval]);
  935.     end;
  936.  
  937.   showlegend(legendtype,legendpos,25);
  938.  
  939.   x:= port[$3da];
  940.   port[$3c0]:= 32;
  941.   mshow;
  942.   level:=1;
  943.   done:= false;
  944.   repeat
  945.     mhide;
  946.     setfillstyle(1,0);
  947.     bar(5,TEXTLOC,64*7-1+MAP_X,477);
  948.     setcolor(15);
  949.     outtextxy(5,TEXTLOC,maps[level].name);
  950.     expand(maps[level].map,levelmap);
  951.     expand(maps[level].objects,objectmap);
  952.     display_map;
  953.     mshow;
  954.     oldx:= 0;
  955.     oldy:= 0;
  956.     key:= #0;
  957.     repeat
  958.       repeat
  959.         mpos(mouseloc);
  960.         x:= mouseloc.column;
  961.         y:= mouseloc.row;
  962.       until (oldx<>x) or (oldy<>y) or keypressed or
  963. (mouseloc.buttonstatus<>0);      oldx:= x;
  964.       oldy:= y;
  965.       if (mouseloc.buttonstatus<>0) then
  966.         begin
  967.           if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  968.             begin
  969.               mhide;
  970.               repeat
  971.                 i:= (x - MAP_X) div 7;
  972.                 j:= (y - MAP_Y) div 7;
  973.                 if currenttype=0 then
  974.                   levelmap[i,j]:= currentval
  975.                 else
  976.                   objectmap[i,j]:= currentval;
  977.                 setfillstyle(1,0);
  978.                 dobar(i*7,j*7,i*7+6,j*7+6);
  979.                 if show_floor then
  980.                   output(i,j,mapgraph[levelmap[i,j]])
  981.                 else
  982.                   if not (levelmap[i,j] in [$6a..$8f]) then
  983.                     output(i,j,mapgraph[levelmap[i,j]]);
  984.                 if show_objects then
  985.                   output(i,j,objgraph[objectmap[i,j]]);
  986.                 mpos(mouseloc);
  987.                 x:= mouseloc.column;
  988.                 y:= mouseloc.row;
  989.               until (not inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y)) or
  990.                     (mouseloc.buttonstatus=0);
  991.               mshow;
  992.             end;
  993.           if inside(464,355,506,378,x,y) then
  994.             begin
  995.               wait_for_mouserelease;
  996.               legendpos:= 0;
  997.               legendtype:= 0;
  998.               showlegend(legendtype,legendpos,25);
  999.             end;
  1000.           if inside(509,355,546,378,x,y) then
  1001.             begin
  1002.               wait_for_mouserelease;
  1003.               legendpos:= 0;
  1004.               legendtype:= 1;
  1005.               showlegend(legendtype,legendpos,25);
  1006.             end;
  1007.           if inside(549,355,576,378,x,y) then
  1008.             begin
  1009.               wait_for_mouserelease;
  1010.               dec(legendpos,25);
  1011.               if legendpos<0 then legendpos:= 0;
  1012.               showlegend(legendtype,legendpos,25);
  1013.             end;
  1014.           if inside(579,355,637,378,x,y) then
  1015.             begin
  1016.               wait_for_mouserelease;
  1017.               inc(legendpos,25);
  1018.               if (legendpos+25)>255 then legendpos:= 255-25;
  1019.               showlegend(legendtype,legendpos,25);
  1020.             end;
  1021.         end;
  1022.       if inside(464,2,637,350,x,y) then
  1023.         begin
  1024.           mhide;
  1025.           j:= (y-2) div 14;
  1026.           setcolor(15);
  1027.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1028.           repeat
  1029.             mpos(mouseloc);
  1030.             newj:= (mouseloc.row-2) div 14;
  1031.             if mouseloc.buttonstatus<>0 then
  1032.               begin
  1033.                 currenttype:= legendtype;
  1034.                 currentval:= legendpos+j;
  1035.                 setfillstyle(1,0);
  1036.                 bar(66*7+MAP_X,60*7+MAP_Y,637,61*7+MAP_Y);
  1037.                 if currenttype=0 then
  1038.                   begin
  1039.                     output(66,60,mapgraph[currentval]);
  1040.                     outtext(67,60,15,' - '+mapnames[currentval]);
  1041.                   end
  1042.                 else
  1043.                   begin
  1044.                     output(66,60,objgraph[currentval]);
  1045.                     outtext(67,60,15,' - '+objnames[currentval]);
  1046.                   end;
  1047.               end;
  1048.           until (newj<>j) or (mouseloc.column<464) or keypressed;
  1049.           setcolor(0);
  1050.           rectangle(465,j*14+2+1,636,j*14+2+12);
  1051.           mshow;
  1052.         end;
  1053.  
  1054.       if inside(MAP_X,MAP_Y,64*7+MAP_X-1,64*7+MAP_Y-1,x,y) then
  1055.         begin
  1056.           i:= (x - MAP_X) div 7;
  1057.           j:= (y - MAP_Y) div 7;
  1058.           if (oldj<>j) or (oldi<>i) then
  1059.             begin
  1060.               outstr:= '(';
  1061.               str(i:2,tempstr);
  1062.               outstr:= outstr+tempstr+',';
  1063.               str(j:2,tempstr);
  1064.               outstr:= outstr+tempstr+')    map: '+hex(levelmap[i,j]);
  1065.               outstr:= outstr+' - '+mapnames[levelmap[i,j]];
  1066.               setfillstyle(1,0);
  1067.               setcolor(15);
  1068.               bar(100,TEXTLOC,64*7+MAP_X-1,479);
  1069.               outtextxy(100,TEXTLOC,outstr);
  1070.               outstr:= '        object: '+hex(objectmap[i,j])+' -
  1071. '+objnames[objectmap[i,j]];              outtextxy(100,TEXTLOC+10,outstr);
  1072.               oldj:= j;
  1073.               oldi:= i;
  1074.             end;
  1075.         end
  1076.       else
  1077.         begin
  1078.           mhide;
  1079.           setfillstyle(1,0);
  1080.           bar(100,TEXTLOC,360,479);
  1081.           mshow;
  1082.         end;
  1083.  
  1084.       if keypressed then
  1085.         begin
  1086.           control:= false;
  1087.           key:= readkey;
  1088.           if key=#0 then
  1089.             begin
  1090.               control:= true;
  1091.               key:= readkey;
  1092.             end;
  1093.           if control then
  1094.             case key of
  1095.               'H':
  1096.                 begin
  1097.                   freemem(maps[level].map.data,maps[level].map.size);
  1098.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1099.                   compress(levelmap,maps[level].map);
  1100.                   compress(objectmap,maps[level].objects);
  1101.                   inc(level);
  1102.                 end;
  1103.               'P':
  1104.                 begin
  1105.                   freemem(maps[level].map.data,maps[level].map.size);
  1106.                   freemem(maps[level].objects.data,maps[level].objects.size);
  1107.                   compress(levelmap,maps[level].map);
  1108.                   compress(objectmap,maps[level].objects);
  1109.                   dec(level);
  1110.                 end;
  1111.             end
  1112.           else
  1113.             case key of
  1114.               'q','Q':
  1115.                    begin
  1116.                      done:= true;
  1117.                      freemem(maps[level].map.data,maps[level].map.size);
  1118.  
  1119. freemem(maps[level].objects.data,maps[level].objects.size);
  1120. compress(levelmap,maps[level].map);
  1121. compress(objectmap,maps[level].objects);                   end;
  1122.               'c','C': clear_level(level);
  1123.               'o','O': begin
  1124.                          mhide;
  1125.                          show_objects:= not show_objects;
  1126.                          display_map;
  1127.                          mshow;
  1128.                        end;
  1129.               'f','F': begin
  1130.                          mhide;
  1131.                          show_floor:= not show_floor;
  1132.                          display_map;
  1133.                          if legendtype=0 then
  1134.                            showlegend(legendtype,legendpos,25);
  1135.                          mshow;
  1136.                        end;
  1137.             end;
  1138.         end;
  1139.     until done or (key in ['P','H']);
  1140.     if level=0 then level:=LEVELS;
  1141.     if level=(LEVELS+1) then level:=1;
  1142.   until done;
  1143.  
  1144.   setfillstyle(1,0);
  1145.   bar(0,TEXTLOC,639,479);
  1146.   setcolor(15);
  1147.   outtextxy(0,TEXTLOC,' Save the current levels to disk? (Y/N) ');
  1148.  
  1149.   repeat
  1150.     repeat until keypressed;
  1151.     key:= readkey;
  1152.     if key=#0 then
  1153.       begin
  1154.         key:= readkey;
  1155.         key:= #0;
  1156.       end;
  1157.   until key in ['y','Y','n','N'];
  1158.  
  1159.   if key in ['y','Y'] then write_levels;
  1160.   textmode(co80);
  1161.   writeln('MapEdit 4.1                 Copyright (c) 1992  Bill Kirby');
  1162.   writeln;
  1163.   writeln('This program is intended to be for your personal use only.');
  1164.   writeln('Distribution of any modified maps may be construed as a ');
  1165.   writeln('copyright violation by Apogee/ID.');
  1166.   writeln;
  1167. end.
  1168.